home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0487.arc / TELLO.ARC / EXE.LSP < prev    next >
Encoding:
Text File  |  1980-01-01  |  1.8 KB  |  43 lines
  1. (defun show-exe (file)
  2.   (setq file (merge-pathnames file ".EXE"))
  3.   (with-open-file (stream file :direction :input :element-type 'unsigned-byte)
  4.     (format t "~&~%EXE file header of ")
  5.     (show-pathname file)
  6.     (format t ":~%~%")
  7.     (let ((signature (show-dbyte "Link signature" t stream)))
  8.       (if (= signature #x5A4D) (format t "  (correct)")
  9.    (format t "  (incorrect)")))
  10.     (let ((leftover (show-dbyte "Image length mod 512" nil stream))
  11.    (pages (show-dbyte "Image length/512" nil stream)))
  12.       (format t "~&Image length: ~D" (+ (* pages 512) leftover)))
  13.     (show-dbyte "Relocation table length" nil stream)
  14.     (show-dbyte "Header size (paragraphs)" nil stream)
  15.     (show-dbyte "Minimum extra memory (paragraphs)" nil stream)
  16.     (show-dbyte "Maximum extra memory (paragraphs)" nil stream)
  17.     (show-dbyte "Stack segment offset" t stream)
  18.     (show-dbyte "Initial SP" t stream)
  19.     (show-dbyte "Checksum" t stream)
  20.     (show-dbyte "Initial IP" t stream)
  21.     (show-dbyte "Code segment offset" t stream)
  22.     (show-dbyte "Relocation table offset" nil stream)
  23.     (show-dbyte "Overlay number" nil stream)))
  24.  
  25. (defun show-dbyte (what hex? stream)
  26.   (let* ((b1 (read-byte stream))
  27.   (b2 (read-byte stream))
  28.   (dbyte (logior (ash b2 8) b1)))
  29.     (format t "~&~A: " what)
  30.     (if hex? (format t "~Xh" dbyte) (format t "~D" dbyte))
  31.     dbyte))
  32.  
  33. (defun show-pathname (pathname)
  34.   (format t "~A\\" (pathname-device pathname))
  35.   (let ((dirs (pathname-directory pathname)))
  36.     (when (listp dirs)
  37.       (setq dirs (rest dirs))
  38.       (do () ((null dirs))
  39.  (format t "~A\\" (first dirs))
  40.  (setq dirs (rest dirs))))
  41.     (format t "~A" (pathname-name pathname))
  42.     (if (pathname-type pathname) (format t ".~A" (pathname-type pathname)))))
  43.